Fourth Week: Hypothesis Testing

تمرین سری چهارم: چقدر ریاضی بلدیم و چرا؟

لطفا مقاله زیر را مطالعه بفرمایید.

چرایی رتبه ضعیف ایران در آزمون تیمز

با استفاده از داده های ارزیابی تیمز ۲۰۱۵ ادعاهای زیر را مورد ارزیابی قراردهید. برای هر سوال علاوه بر استدلال آماری که در غالب آزمون فرض تعریف می شود از تصویرسازی مناسب باهر دو ابزار ggplot2 و highcharter استفاده نمایید. به دلخواه به هفت گزاره از موارد زیر پاسخ دهید.

پیش از شروع به حل کردن متوجه می شویم که نمرات به آن گونه ای که انتظار داشته ایم برای هر سوال داده نشده اند! برای اینکه داده ها را به صورت قابل پذیرش به دست آوریم از چند تابع کمک می گیریم. البته در ادامه می بینیم که این کارها صرفا به درد سوال ۶ می خورند!

library(knitr)
library(kableExtra)
library(dplyr)
library(readr)
library(tidyr)
library(readxl)
library(ggplot2)
library(highcharter)
library(formattable)


setwd("/Users/macbook/Desktop/96-97-2/Data\ Analysis/timss15_grade_8")

read_xlsx("T15_G8_ItemInformation.xlsx", sheet = "MAT") -> info_m
read_xlsx("T15_G8_ItemInformation.xlsx", sheet = "SCI") -> info_s
info <- bind_rows(info_m, info_s)

read_xlsx("T15_G8_Codebook.xlsx", sheet = "BSA") -> CB_BSA

read_rds("data/bsa.rds") -> BSA
read_rds("data/bst.rds") -> BST
read_rds("data/bts.rds") -> BTS
read_rds("data/btm.rds") -> BTM
read_rds("data/bcg.rds") -> BCG
read_rds("data/bsg.rds") -> BSG


BSA$itsex <- replace(BSA$itsex,BSA$itsex == 1, "F")
BSA$itsex <- replace(BSA$itsex,BSA$itsex == 2, "M")
BSA$itsex <- as.factor(BSA$itsex)


left_join(x = info,
          y =  CB_BSA %>% rename(`Item ID` = Variable),
          by = "Item ID") -> questions_info

questions_info_f <- questions_info
questions_info_f$`Value Scheme Detailed` <-
  as.factor(paste(
    questions_info$`Value Scheme Detailed`,
    "  /  ",
    questions_info$`Maximum Points`
  ))
questions_info_f$`Item ID` <- tolower(questions_info_f$`Item ID`)



questions_info_f %>%
  select(`Value Scheme Detailed`) %>%
  unique() %>%
  arrange(`Value Scheme Detailed`) %>%
  mutate(level = as.numeric(`Value Scheme Detailed`)) -> marking_scheme

questions_scheme_type <-
  questions_info_f %>% select(Question = `Item ID`, `Value Scheme Detailed`)

#write_csv(marking_scheme, "../HW/HW4/Problems/hw_04/Solutions/marking_scheme.csv")

hed <- function(data) {
  View(head(data, 10))
}

getMark <- function(questions, answers) {
  mark <- rep(NA, length(answers))
  questions_type <-
    as.numeric(
      left_join(questions,
                questions_scheme_type,
                by = "Question")$`Value Scheme Detailed`
    )
  full_marks <- rep(0, length(answers))
  result <- mark %>%
    replace(questions_type == 1 & answers == 4, 1) %>%
    replace(questions_type > 1 &
              questions_type <= 3 & answers == 3, 1) %>%
    replace(questions_type > 3 &
              questions_type <= 6 & answers == 2, 1) %>%
    replace(questions_type > 6 &
              questions_type <= 10 & answers == 1, 1) %>%
    
    replace(questions_type == 1 & answers != 4, 0) %>%
    replace(questions_type > 1 &
              questions_type <= 3 & answers != 3, 0) %>%
    replace(questions_type > 3 &
              questions_type <= 6 & answers != 2, 0) %>%
    replace(questions_type > 6 &
              questions_type <= 10 & answers != 1, 0) %>%
    
    replace(questions_type > 10 &
              questions_type <= 23 &
              answers <= 20 & answers >= 10,
            1) %>%
    replace(questions_type > 10 &
              questions_type <= 23 &
              answers <= 80 & answers >= 70,
            0) %>%
    
    replace(questions_type > 23 &
              questions_type <= 27 &
              answers < 20 & answers >= 10,
            0.5) %>%
    replace(questions_type > 23 &
              questions_type <= 27 &
              answers <= 22 & answers >= 20,
            1) %>%
    replace(questions_type > 23 &
              questions_type <= 27 &
              answers <= 80 & answers >= 70,
            0) %>%
    
    replace(questions_type == 28 &
              answers == 10,
            0.5) %>%
    replace(questions_type == 28 &
              answers == 20,
            1) %>%
    replace(questions_type == 28 &
              answers == 79,
            0) %>%
    
    replace(questions_type == 29 &
              answers == 10,
            0.5) %>%
    replace(questions_type == 29 &
              answers == 20,
            1) %>%
    replace(questions_type == 29 &
              answers == 79,
            0)
  weights <- left_join(questions,
                            questions_info_f %>% select(Question = `Item ID`, weight = `Maximum Points`),
                            by = "Question")$weight
  ret <- data.frame(cbind(score = result, weight = weights))
  ret$weight <- as.numeric(ret$weight)
  ret$score <- as.numeric(ret$score)
  return(ret)
}

---

۱. میران رضایت معلمان در پیشرفت تحصیلی دانش آموزان موثر است.

برای پاسخگویی به این سوال ابتدا با جمع زدن چند شاخص رضایت شغلی معلمان معیاری کلی برای مشخص کردن سطح رضایت دست پیدا می کنیم. سپس با استفاده از کریلیشن تست و استفاده از متد اسپیرمن این ادعا را بررسی می کنیم. نتیجه ی آن هم این است که میزان رضایت معلمان با عملکرد دانش آموزان رابطه ی عکس دارد.

st <- BST %>%
  select(c(idcntry:idlink))

teachersM <-
  BTM %>%
  mutate(sat = (28 - btbg10a + btbg10b + btbg10c + btbg10d +
                  btbg10e + btbg10f + btbg10g)) %>%
  select(c(idcntry:idlink, sat))

teachersS <-
  BTS %>%
  mutate(sat = (28 - btbg10a + btbg10b + btbg10c + btbg10d +
                  btbg10e + btbg10f + btbg10g)) %>%
  select(c(idcntry:idlink, sat))

full_join(teachersM, st) -> st_M
full_join(teachersS, st) -> st_S

bsa_m <-
  BSA %>% select(idcntry:idstud, bsmmat01:bsmmat05) %>%
  group_by(idcntry, idbook, idschool, idclass, idstud) %>%
  summarize(score = mean(bsmmat01:bsmmat05)) %>%
  ungroup()

bsa_s <-
  BSA %>% select(idcntry:idstud, bsssci01:bsssci05) %>%
  group_by(idcntry, idbook, idschool, idclass, idstud) %>%
  summarize(score = mean(bsssci01:bsssci05)) %>%
  ungroup()

full_join(st_M, bsa_m) -> sts_M
full_join(st_S, bsa_s) -> sts_S

rbind(sts_M, sts_S) %>% filter(!is.na(score)) -> sts


kable(unlist(cor.test(sts$sat, sts$score, alternative = "greater", method = "spearman")))

	x
statistic.S	43135807519203784
p.value	4.53299399101593e-74
estimate.rho	0.022670128216608
null.value.rho	0
alternative	greater
method	Spearman’s rank correlation rho
data.name	sts\(sat and sts\)score

sts$sat <- as.character(sts$sat)
sts %>% group_by(sat) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(sat)) -> sts_m
sts_m$sat <- as.numeric(sts_m$sat)
sts$sat <- as.numeric(sts$sat)

sts %>% filter(!is.na(sat), !is.na(score))%>% sample_n(5000) -> sts_sample_5000
hchart(
  sts_sample_5000,
  type = "scatter",
  hcaes(sat, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
  hc_add_series(
    data = sts_m,
    type = "line",
    hcaes(sat, round(mean_score, 2)),
    color = hex_to_rgba(x <- "#fdb462", alpha = 1)
  ) %>%
  hc_title(text = "Teachers' Satisfaction Level and Score Relation") %>%
  hc_xAxis(title = list(text = "Satisfaction Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot( x = sts_sample_5000$score, var = sts_sample_5000$sat, outliers = F) %>% 
  hc_chart(type = "column") %>%
  hc_title(text = "Teachers' Satisfaction Level and Score Relation") %>%
  hc_xAxis(title = list(text = "Satisfaction Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(sts %>% filter(!is.na(sat), !is.na(score)), aes(x = sat, y = score)) +
  geom_boxplot(aes(group = sat, y = score, fill = sat))+
  geom_line(data = sts_m, aes(x = sat, y = mean_score), color = "#fdb462")+
  xlab("Satisfaction Level") +
  ylab("Score") +
  ggtitle("Teachers' Satisfaction Level and Score Relation")

---

۲. والدینی که تحصیلات بیشتری دارند دارای فرزندان موفق تری می باشند.

ابتدا برای هر والد و هر فرزند یک سطر ایجاد می کنیم و میزان تحصیلات آن والد را جلوی آن می نویسیم. سپس با آنووا بررسی می کنیم که آیا تحصیلات موثر است یا نه. سپس با تی تست( از آنجایی که نمرات از توزیع نرمال پیروزی می کنند می توان از تی تست استفاده کرد.) بیشترین سطح تحصیلات را با بقیه ی سطوح و همچنین کمترین سطح تحصیلات را با بقیه ی سطوح مقایسه می کنیم و مشاهده می کنیم که سطح تحصیلات موثر است.

BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , bsbg07a, bsbg07b) %>%
  mutate(
    score = (
      bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
        bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
    ) / 10
  ) %>%
  gather(Parent_Type, Education, c(bsbg07a, bsbg07b)) %>%
  select(c(idcntry:idstud, score, Parent_Type, Education)) %>%
  filter(!is.na(Education), !is.na(score), Education != 8) -> parent_education


kable(unlist(summary.aov(
  aov(formula = score ~ Education,
      data = parent_education)
)))

	x
Df1	1.000000e+00
Df2	3.813390e+05
Sum Sq1	5.134845e+08
Sum Sq2	3.662261e+09
Mean Sq1	5.134845e+08
Mean Sq2	9.603687e+03
F value1	5.346743e+04
F value2	NA
Pr(>F)1	0.000000e+00
Pr(>F)2	NA

kable(unlist(t.test((parent_education %>% filter(Education == 7))$score,
                    (parent_education %>% filter(Education != 7))$score,
                    alternative = "greater"
)))

	x
statistic.t	87.0771358971654
parameter.df	62288.3374964784
p.value	0
conf.int1	42.1391667756837
conf.int2	Inf
estimate.mean of x	522.295093618767
estimate.mean of y	479.344596392976
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(parent_education %>% filter(Education == 7))\(score and (parent_education %>% filter(Education != 7))\)score

kable(unlist(t.test((parent_education %>% filter(Education == 1))$score,
                    (parent_education %>% filter(Education != 1))$score,
                    alternative = "less"
)))

	x
statistic.t	-154.496091364706
parameter.df	50187.6169610853
p.value	0
conf.int1	-Inf
conf.int2	-77.7842254927923
estimate.mean of x	414.054563368858
estimate.mean of y	492.675851448884
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(parent_education %>% filter(Education == 1))\(score and (parent_education %>% filter(Education != 1))\)score

parent_education %>% group_by(Education) %>% summarize(mean_score = mean(score)) -> education_mean_score

parent_education %>% filter(!is.na(Education), !is.na(score)) %>% sample_n(5000) -> pe_sample_5000

hchart(
  pe_sample_5000,
  type = "scatter",
  hcaes(Education, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
  hc_add_series(
    data = education_mean_score,
    type = "line",
    hcaes(Education, round(mean_score, 2)),
    color = hex_to_rgba(x <-
                          "#fdb462")
  ) %>%
  hc_title(text = "Parent's Education and Score Relation") %>%
  hc_xAxis(title = list(text = "Education Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot(x = pe_sample_5000$score,
          var = pe_sample_5000$Education,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Parent's Education and Score Relation") %>%
  hc_xAxis(title = list(text = "Education Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(parent_education %>% sample_n(20000),
       aes(x = Education, y = score)) +
  geom_boxplot(aes(group = Education, y = score, fill = Education)) +
  geom_line(data = education_mean_score,
            aes(x = Education, y = mean_score),
            color = "#fdb462") +
  xlab("Education Level") +
  ylab("Score") +
  ggtitle("Parent's Education and Score Relation")

---

۳. امکانات رفاهی در خانه موجب پیشرفت تحصیلی می گردد.

ابتدا با توجه به تعداد امکانات رفاهی موجود در منزل دانش آموز به آن یک عدد نسبت می دهیم. سپس با آنوا بررسی می کنیم تا ببینیم آیا اصلن امکانات رفاهی تاثیری دارند یا نه. سپس با استفاده از تی تست میانگین افرادی که بیشترین سطح رفاه را دارند با بقیه مقایسه می کنیم و سپس هم میانگین افرادی که کمترین سطح رفاه را دارند. در نهایت مشاهده می کنیم که سطح امکانات رفاهی در خانه موثر است.

BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , bsbg06a:bsbg06g) %>%
  mutate(
    score = (
      bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
        bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
    ) / 10
  ) %>%
  mutate(Value = -(bsbg06a + bsbg06b + bsbg06c + bsbg06d + bsbg06e + bsbg06g) + 12) %>%
  select(c(idcntry:idstud, score, Value)) %>%
  filter(!is.na(Value), !is.na(score)) -> WF

kable(unlist(summary.aov(
  aov(formula = score ~ Value,
      data = WF)
)))

	x
Df1	1.000000e+00
Df2	2.635220e+05
Sum Sq1	2.850287e+08
Sum Sq2	2.457311e+09
Mean Sq1	2.850287e+08
Mean Sq2	9.324882e+03
F value1	3.056647e+04
F value2	NA
Pr(>F)1	0.000000e+00
Pr(>F)2	NA

kable(unlist(t.test((WF %>% filter(Value == 6))$score,
                    (WF %>% filter(Value != 6))$score,
                    alternative = "greater"
)))

	x
statistic.t	94.2090151332388
parameter.df	113416.215913909
p.value	0
conf.int1	39.6923796189657
conf.int2	Inf
estimate.mean of x	513.28388306715
estimate.mean of y	472.886168939971
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(WF %>% filter(Value == 6))\(score and (WF %>% filter(Value != 6))\)score

kable(unlist(t.test((WF %>% filter(Value == 0))$score,
                    (WF %>% filter(Value != 0))$score,
                    alternative = "less"
)))

	x
statistic.t	-93.6009381514327
parameter.df	5649.7767282158
p.value	0
conf.int1	-Inf
conf.int2	-104.693426315326
estimate.mean of x	377.699116972128
estimate.mean of y	484.265547222443
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(WF %>% filter(Value == 0))\(score and (WF %>% filter(Value != 0))\)score

WF$Value <- as.character(WF$Value)
WF %>% group_by(Value) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(Value)) -> WF_m
WF_m$Value <- as.numeric(WF_m$Value)
WF$Value <- as.numeric(WF$Value)

WF %>% filter(!is.na(Value), !is.na(score)) %>% sample_n(5000) -> wf_sample_5000

hchart(
  WF %>% sample_n(5000),
  type = "scatter",
  hcaes(Value, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
  hc_add_series(
    data = WF_m,
    type = "line",
    hcaes(Value, round(mean_score, 2)),
    color = hex_to_rgba(x <- "#fdb462")
  )  %>% 
  hc_title(text = "Home Wellfare and Score Relation") %>%
  hc_xAxis(title = list(text = "Home Wellfare Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot(x = wf_sample_5000$score,
          var = wf_sample_5000$Value,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Home Wellfare and Score Relation") %>%
  hc_xAxis(title = list(text = "Home Wellfare Level")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(WF %>% sample_n(20000), aes(x = Value, y = score)) +
  geom_boxplot(aes(group = Value, y = score, fill = Value)) +
  geom_line(data = WF_m, aes(x = Value, y = mean_score), color = "#fdb462")+
  xlab("Home Wellfare Level") +
  ylab("Score") +
  ggtitle("Home Wellfare and Score Relation")

---

۴. محیط آرام مدرسه نقش مهمی در پیشرفت تحصیلی دارد.

---

۵. معلمان با تحصیلات بالاتر یا تجربه بیشتر دانش آموزان موفق تری تربیت می کنند.

---

۶. پسران در کاربرد هندسه قوی تر هستند.

ابتدا با استفاده از تابعی که پیش از همه ی سوالات نوشته ایم نمرات افراد را بدست می آوریم. به پاسخ کامل نمره ی کامل، به پاسخ نصفه نصف نمره و به پاسخ غلط ۰ امتیاز تعلق گرفته است. همچنین وزن هر سوال حداکثر امتیاز ممکن از آن است. سپس چون نمرات تنها مربوط به کابرد هندسه هستند و سوالات کمی را شامل می شوند نمی توانیم از تی تست استفاده کنیم چون توزیع آن ها نرمال نمی شود. بنابراین از پرمیوتیشن تست استفاده می کنیم و در نهایت مشاهده می کنیم که عملکرد پسر ها در کاربرد هندسه بهتر از دخترهاست.

geo_app_qi <- questions_info_f %>%
  filter(`Content Domain` == "Geometry",
         `Cognitive Domain` == "Applying")

applying_geometry_questions <- geo_app_qi$`Item ID`

BSA_math <- BSA %>%
  select(idcntry:m062120, itsex)

BSA_math %>%
  gather(Question, Value , m042182:m062120) -> BSA_math_gathered

BSA_math_gathered %>%
  filter(Question %in% applying_geometry_questions,
         !is.na(Value),
         !is.na(itsex)) -> student_app_geo

marx <-
  getMark(student_app_geo %>% select(Question), student_app_geo$Value)
sex_marx <-
  data.frame(cbind(sex = as.character(student_app_geo$itsex), marx))
sex_marx$sex <- as.factor(sex_marx$sex)

library(perm)                  # for Permutation Test
kable(unlist(permTS(
  (sex_marx$score * sex_marx$weight) ~ sex_marx$sex,
  alternative = "less"
)))

	x
statistic.Z	-9.36449093134983
estimate.mean sex_marx\(sex=F - mean sex_marx\)sex=M	-0.0108587393564316
p.value	3.82088880542399e-21
null.value.mean sex_marx\(sex=F - mean sex_marx\)sex=M	0
alternative	less
method	Permutation Test using Asymptotic Approximation
data.name	(sex_marx\(score * sex_marx\)weight) by sex_marx$sex
p.values.p.twosided	7.64177761084799e-21
p.values.p.lte	3.82088880542399e-21
p.values.p.gte	1
p.values.p.twosidedAbs	0

student_app_geo <- cbind(student_app_geo, marx)

sex_app_geo <- student_app_geo %>%
  group_by(itsex) %>%
  summarize(mean_score = weighted.mean(score, weight)) %>%
  ungroup()
ggplot(sex_app_geo,
       aes(x = itsex, y = mean_score, fill = itsex)) +
  geom_bar(position = "dodge", stat = "identity") +
  guides(fill = F) +
  xlab("Gender") +
  ylab("Avg. Score") +
  ggtitle("Male vs. Female Performance in Applying Geometry") + coord_flip()

sex_app_geo %>% mutate(mean_score = round(mean_score, 3)) %>%
  hchart(type = "bar", hcaes(x = itsex, y = mean_score, color = itsex)) %>%
  hc_title(text = "Male vs. Female Performance in Applying Geometry") %>%
  hc_xAxis(title = list(text = "Gender")) %>%
  hc_yAxis(title = list(text = "Avg. Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

---

۷. تغذیه دانش آموزان نقش اساسی در یادگیری آنها دارد.

برای پاسخ دادن به این سوال از داده ی مربوط به صبحانه ی دانش آموزان استفاده می کنیم. به این صورت که ایتدا روی ۴ دسته آنووا می زنیم و مشاهده می کنیم که خوردن صبحانه موثر است. سپس برای بررسی تاثیر آن بیشترین و کمترین های صبحانه خوردن را جدا می کنیم و روی آن ها تی تست می زنیم. مشاهده می کنیم که کسانی که صبحانه بیش از بقیه می خورند عملکرد بهتری نسبت به بقیه دارند. ولی کسانی که صبحانه نمی خورند الزامن عملکرد بدتری ندارند(پی ولیو ۰.۰۸ است که برای اثبات کمتر بودن میانگین آن ها کافی نیست.).

## only breakfast exists in data
BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , food = bsbg12) %>%
  mutate(
    food = 4 - food,
    score = (
      bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
        bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
    ) / 10
  ) %>%
  select(idcntry:idstud, food, score) %>%
  filter(!is.na(food), !is.na(score)) -> sb

kable(unlist(summary.aov(
  aov(formula = score ~ food,
      data = sb)
)))

	x
Df1	1.000000e+00
Df2	2.760780e+05
Sum Sq1	2.946775e+07
Sum Sq2	2.913609e+09
Mean Sq1	2.946775e+07
Mean Sq2	1.055357e+04
F value1	2.792206e+03
F value2	NA
Pr(>F)1	0.000000e+00
Pr(>F)2	NA

kable(unlist(t.test((sb %>% filter(food == 3))$score,
                    (sb %>% filter(food != 3))$score,
                    alternative = "greater"
)))

	x
statistic.t	50.99563010955
parameter.df	269579.61804312
p.value	0
conf.int1	19.373009156284
conf.int2	Inf
estimate.mean of x	490.448372359993
estimate.mean of y	470.42966155926
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(sb %>% filter(food == 3))\(score and (sb %>% filter(food != 3))\)score

kable(unlist(t.test((sb %>% filter(food == 0))$score,
                    (sb %>% filter(food != 0))$score,
                    alternative = "less"
)))

	x
statistic.t	-1.39097171740675
parameter.df	46479.2518208822
p.value	0.0821203309309085
conf.int1	-Inf
conf.int2	0.142680564060984
estimate.mean of x	479.409892318849
estimate.mean of y	480.191511633823
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(sb %>% filter(food == 0))\(score and (sb %>% filter(food != 0))\)score

sb$food <- as.character(sb$food)
sb %>% group_by(food) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(food)) -> sb_m
sb_m$food <- as.numeric(sb_m$food)
sb$food <- as.numeric(sb$food)

sb %>% filter(!is.na(food), !is.na(score)) %>% sample_n(5000) -> sb_sample_5000

hchart(
  sb_sample_5000,
  type = "scatter",
  hcaes(food, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
  hc_add_series(
    data = sb_m,
    type = "line",
    hcaes(food, round(mean_score, 2)),
    color = hex_to_rgba(x <- "#fdb462")
  ) %>% 
  hc_title(text = "Eating Breakfast and Score Relation") %>%
  hc_xAxis(title = list(text = "Eating Breakfast")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot(x = sb_sample_5000$score,
          var = sb_sample_5000$food,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Eating Breakfast and Score Relation") %>%
  hc_xAxis(title = list(text = "Eating Breakfast")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(sb %>% sample_n(20000), aes(x = food, y = score)) +
  geom_boxplot(aes(group = food, y = score, fill = food)) +
  geom_line(data = sb_m, aes(x = food, y = mean_score), color = "#fdb462")+
  xlab("Eating Breakfast") +
  ylab("Score") +
  ggtitle("Eating Breakfast and Score Relation")

***

۸. مدارس با امکانات بیشتر دارای عملکرد بهتری می باشند.

---

۹. علت افت تحصیلی عدم مشارکت در کلاس است.

برای حل این سوال پاسخ دانش آموزان به پرسش مربوط به حضور در کلاس را بررسی می کنیم و بر اساس پاسخ آنان آنان را به ۴ دسته تقسیم می کنیم و روی ۴ دسته آنووا می زنیم. سپس با استفاده از تی تست مشاهده می کنیم که کسانی که حضور در کلاس بیشتری دارند نسبت به بقیه عملکرد بهتری دارند. همچنین کسانی که کمترین سطح حضور در کلاس را دارند هم عملکرد بدتری نسبت به بقیه دارند.

BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , presence  = bsbg11) %>%
  mutate(
    score = (
      bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05 +
        bsssci01 + bsssci02 + bsssci03 + bsssci04 + bsssci05
    ) / 10
  ) %>%
  select(idcntry:idstud, presence, score) %>%
  filter(!is.na(presence), !is.na(score)) -> sp

kable(unlist(summary.aov(aov(
  formula = score ~ presence,
  data = sp
))))

	x
Df1	1.000000e+00
Df2	2.649830e+05
Sum Sq1	2.634716e+08
Sum Sq2	2.580175e+09
Mean Sq1	2.634716e+08
Mean Sq2	9.737134e+03
F value1	2.705844e+04
F value2	NA
Pr(>F)1	0.000000e+00
Pr(>F)2	NA

kable(unlist(t.test((sp %>% filter(presence == 4))$score,
                    (sp %>% filter(presence != 4))$score,
                    alternative = "greater"
)))

	x
statistic.t	125.952922226406
parameter.df	212645.476955177
p.value	0
conf.int1	50.1708610795478
conf.int2	Inf
estimate.mean of x	499.026664285963
estimate.mean of y	448.191935703561
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(sp %>% filter(presence == 4))\(score and (sp %>% filter(presence != 4))\)score

kable(unlist(t.test((sp %>% filter(presence == 1))$score,
                    (sp %>% filter(presence != 1))$score,
                    alternative = "less"
)))

	x
statistic.t	-149.010036269642
parameter.df	24825.6743803324
p.value	0
conf.int1	-Inf
conf.int2	-98.3720912438415
estimate.mean of x	387.717950430649
estimate.mean of y	487.188087995572
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(sp %>% filter(presence == 1))\(score and (sp %>% filter(presence != 1))\)score

sp$presence <- as.character(sp$presence)
sp %>% group_by(presence) %>% summarize(mean_score = mean(score)) %>% filter(!is.na(presence)) -> sp_m
sp_m$presence <- as.numeric(sp_m$presence)
sp$presence <- as.numeric(sp$presence)


sp %>% filter(!is.na(presence), !is.na(score)) %>% sample_n(5000) -> sp_sample_5000

hchart(
  sp_sample_5000,
  type = "scatter",
  hcaes(presence, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.5)
) %>%
  hc_add_series(
    data = sp_m,
    type = "line",
    hcaes(presence, round(mean_score, 2)),
    color = hex_to_rgba(x <- "#fdb462")
  ) %>%
  hc_title(text = "Presence in Class and Score Relation") %>%
  hc_xAxis(title = list(text = "Presence in Class")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot(x = sp_sample_5000$score,
          var = sp_sample_5000$presence,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Presence in Class and Score Relation") %>%
  hc_xAxis(title = list(text = "Presence in Class")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(sp %>% sample_n(50000), aes(x = presence, y = score)) +
  geom_boxplot(aes(group = presence, y = score, fill = presence)) +
  geom_line(data = sp_m,
            aes(x = presence, y = mean_score),
            color = "#fdb462") +
  xlab("Presence in Class") +
  ylab("Score") +
  ggtitle("Presence in Class and Score Relation")+
  guides(fill = F)

---

۱۰. دانش آموزان ایرانی در استدلال قوی تر از کاربرد هستند.

۲ دسته را جدا می کنیم و از آن جایی که معمولن توزیع نمرات از توزیع نرمال پیروی می کند از تی تست برای مقایسه ی میانگین ۲ دسته استفاده می کنیم. پی ولیوی نتایج حدودا ۰.۳ می شود که نتیجه می دهد شواهد کافی برای اثبات اینکه دانش آموزان ایرانی در استدلال قوی تر از کاربرد هستند وجود ندارد.

iran_app_rea <-
  BSA %>% select(idcntry:idstud, bsmapp01:bsmrea05, bssapp01:bssrea05) %>%
  filter(idcntry == 364) %>%
  group_by(idcntry, idbook, idschool, idclass, idstud) %>%
  summarize(Applying = mean(c(bsmapp01:bsmapp05, bssapp01:bssapp05)),
            Reasoning = mean(c(bsmrea01:bsmrea05, bssrea01:bssrea05))) %>%
  ungroup() %>%
  gather(Section, Score, Applying, Reasoning)

kable(unlist(t.test((iran_app_rea %>% filter(Section == "Applying"))$Score,
                    (iran_app_rea %>% filter(Section == "Reasoning"))$Score,
                    alternative = "greater"
)))

	x
statistic.t	0.453536835906057
parameter.df	12248.1443007616
p.value	0.325085129952664
conf.int1	-1.90984082263893
conf.int2	Inf
estimate.mean of x	451.805468324821
estimate.mean of y	451.078463788235
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(iran_app_rea %>% filter(Section == “Applying”))\(Score and (iran_app_rea %>% filter(Section == "Reasoning"))\)Score

hcboxplot(x = round(iran_app_rea$Score,2),
          var = iran_app_rea$Section,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Iranians in Applying vs Reasoning") %>%
  hc_xAxis(title = list(text = "Section")) %>%
  hc_yAxis(title = list(text = "Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(iran_app_rea, aes(x = Section, y = Score)) +
  geom_boxplot(aes(group = Section, y = Score, fill = Section)) +
  xlab("Section") +
  ylab("Score") +
  ggtitle("Iranians in Applying vs Reasoning")+
  guides(fill = F)

---

سه گزاره جالب کشف کنید و ادعای خود را ثابت نمایید.

ادعا می کنیم که برخلاف تصور موجود معلمینی که در روزهای بیشتری از هفته به دانش آموزان تمرین می دهند میانگین عملکرد بدتری نسبت به بقیه دارند. برای بررسی این موضوع از تی تست استفاده می کنیم.

st <- BST %>%
  select(c(idcntry:idlink))

teachersM <-
  BTM %>%
  mutate(assignments =  btbm22a) %>%
  select(c(idcntry:idlink, assignments))

full_join(teachersM, st) -> st_M

bsa_m <-
  BSA %>% select(idcntry:idstud, bsmmat01:bsmmat05) %>%
  group_by(idcntry, idbook, idschool, idclass, idstud) %>%
  summarize(score = mean(bsmmat01:bsmmat05)) %>%
  ungroup()

full_join(st_M, bsa_m) -> sts_M

kable(unlist(t.test((sts_M %>% filter(assignments == 5))$score,
                    (sts_M %>% filter(assignments != 5))$score,
                    alternative = "less"
)))

	x
statistic.t	-7.09823162186523
parameter.df	134291.412657605
p.value	6.34926740090916e-13
conf.int1	-Inf
conf.int2	-2.54666611992219
estimate.mean of x	476.303468078156
estimate.mean of y	479.618269218304
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(sts_M %>% filter(assignments == 5))\(score and (sts_M %>% filter(assignments != 5))\)score

sts_M$assignments <- as.character(sts_M$assignments)
sts_M %>%
  group_by(assignments) %>%
  summarize(mean_score = mean(score)) %>% filter(!is.na(assignments)) -> sts_M_m
sts_M_m$assignments <- as.numeric(sts_M_m$assignments)
sts_M$assignments <- as.numeric(sts_M$assignments)

sts_M %>% filter(!is.na(assignments), !is.na(score)) %>% sample_n(5000) -> sts_M_sample_5000

hchart(
  sts_M_sample_5000,
  type = "scatter",
  hcaes(assignments, round(score, 2)),
  color = hex_to_rgba(x <- "#386cb0", alpha = 0.1)
) %>%
  hc_add_series(
    data = sts_M_m,
    type = "line",
    hcaes(assignments, round(mean_score, 2)),
    color = hex_to_rgba(x <- "#fdb462", alpha = 1)
  ) %>%
  hc_title(text = "Homework Frequency and Score Relation") %>%
  hc_xAxis(title = list(text = "Homework Frequency")) %>%
  hc_yAxis(title = list(text = "Score")) %>%
  hc_add_theme(hc_theme_sandsignika())

hcboxplot(x = sts_M_sample_5000$score,
          var = sts_M_sample_5000$assignments,
          outliers = F) %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Homework Frequency and Score Relation") %>%
  hc_xAxis(title = list(text = "Homework Frequency")) %>%
  hc_yAxis(title = list(text = "Score")) %>%
  hc_add_theme(hc_theme_sandsignika())

ggplot(sts_M %>% filter(!is.na(assignments), !is.na(score)) %>% sample_n(50000),
       aes(x = assignments, y = score)) +
  geom_boxplot(aes(group = assignments, y = score, fill = assignments)) +
  geom_line(data = sts_M_m, aes(x = assignments, y = mean_score), color = "#fdb462")+
  xlab("Homework Frequency") +
  ylab("Score") +
  ggtitle("Homework Frequency and Score Relation")+
  guides(fill = F)

---

در پرسشنامه قسمتی مربوط به گذراندن کلاس در خارج از محیط مدرسه بود و همچنین پرسشی هم از کسانی که در خارج از مدرسه کلاس می گذرانند شده بود که با چه هدفی در خارج از مدرسه کلاس می گذرانند. در این قسمت میانگین عملکرد دانش آموزانی که کلن کلاس بیرون از مدرسه نمی روند و کسانی را که ادعا کرده اند برای ممتاز بودن در کلاس های خارج از مدرسه شرکت می کنند را مقایسه می کنیم و با استفاده از تی تست مشاهده می کنیم که میانگین کسانی که کللن در کلاس های خارج از مدرسه شرکت نمی کنند بهتر است.

## Taking classes to excel in class

BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , bsbm39aa) %>%
  filter(!is.na(bsbm39aa)) %>% 
  filter(bsbm39aa != 2) %>% 
  mutate(
    score = (
      bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05
    ) / 5,
    to_excel = (bsbm39aa == 1)
  ) %>%
  select(c(idcntry:idstud, score, to_excel)) %>%
  filter(!is.na(to_excel), !is.na(score)) -> math_class_purpose


kable(unlist(t.test((math_class_purpose %>% filter(to_excel == T))$score,
       (math_class_purpose %>% filter(to_excel == F))$score,
       alternative = "less")))

	x
statistic.t	-82.0164324715587
parameter.df	114198.574425878
p.value	0
conf.int1	-Inf
conf.int2	-40.5893755655582
estimate.mean of x	456.929509645799
estimate.mean of y	498.349578539189
null.value.difference in means	0
alternative	less
method	Welch Two Sample t-test
data.name	(math_class_purpose %>% filter(to_excel == T))\(score and (math_class_purpose %>% filter(to_excel == F))\)score

math_class_purpose_mean <-  math_class_purpose%>% 
  group_by(to_excel) %>% 
  summarize(mean_score = mean(score))

ggplot(math_class_purpose_mean,
       aes(x = to_excel, y = mean_score, fill = to_excel)) +
  geom_bar(position = "dodge", stat = "identity") +
  guides(fill = F) +
  xlab("To Excel and not Taken") +
  ylab("Avg. Score") +
  ggtitle("To Excel and not Taken and Score") + coord_flip()

math_class_purpose_mean %>% mutate(mean_score = round(mean_score, 2)) %>%
  hchart(type = "bar", hcaes(x = as.factor(to_excel), y = mean_score, color = as.factor(to_excel))) %>%
  hc_title(text = "Score ~ To Excel and not Taken") %>%
  hc_xAxis(title = list(text = "To Excel and not Taken")) %>%
  hc_yAxis(title = list(text = "Avg. Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())

---

در این قسمت هم میانگین عملکرد مهاجرین را با میانگین عملکرد غیرمهاجرین از طریق تی تست مقایسه می کنیم و مشاهده می کنیم که مهاجرین به طور میانگین عملکرد بهتری در آزمون دارند.

## Comparing immigrants who have immigrated earlier to  others

BSG %>%
  select(idcntry:idstud, bsmmat01:bsssci05 , bsbg10a) %>%
  filter(!is.na(bsbg10a)) %>%
  mutate(
    score = (bsmmat01 + bsmmat02 + bsmmat03 + bsmmat04 + bsmmat05) / 5,
    immigrated = (bsbg10a == 2)
  ) %>%
  select(c(idcntry:idstud, score, immigrated)) %>%
  filter(!is.na(immigrated), !is.na(score)) -> immigration_score


kable(unlist(t.test((immigration_score %>% filter(immigrated == T))$score,
       (immigration_score %>% filter(immigrated == F))$score,
       alternative = "greater"
)))

	x
statistic.t	33.437236974174
parameter.df	39567.5108480879
p.value	4.65533097277504e-242
conf.int1	19.5619658256152
conf.int2	Inf
estimate.mean of x	495.795120030461
estimate.mean of y	475.221045033097
null.value.difference in means	0
alternative	greater
method	Welch Two Sample t-test
data.name	(immigration_score %>% filter(immigrated == T))\(score and (immigration_score %>% filter(immigrated == F))\)score

immigration_score_mean <-  immigration_score %>%
  group_by(immigrated) %>%
  summarize(mean_score = mean(score))

ggplot(
  immigration_score_mean,
  aes(x = immigrated, y = mean_score, fill = immigrated)
) +
  geom_bar(position = "dodge", stat = "identity") +
  guides(fill = F) +
  xlab("Immigrated") +
  ylab("Avg. Score") +
  ggtitle("Immigration and Score") + coord_flip()

immigration_score_mean %>% mutate(mean_score = round(mean_score, 2)) %>%
  hchart(type = "bar", hcaes(
    x = as.factor(immigrated),
    y = mean_score,
    color = as.factor(immigrated)
  )) %>%
  hc_title(text = "Immigration and Score") %>%
  hc_xAxis(title = list(text = "Immigrated")) %>%
  hc_yAxis(title = list(text = "Avg. Score"))  %>%
  hc_add_theme(hc_theme_sandsignika())